home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr50
/
pbc22b.zip
/
PBC$BAS.ZIP
/
DCALENDA.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-01-01
|
5KB
|
127 lines
' +----------------------------------------------------------------------+
' | |
' | PBClone Copyright (c) 1990-1993 Thomas G. Hanlin III |
' | |
' +----------------------------------------------------------------------+
DECLARE SUB CalcAttr (BYVAL Foreground%, BYVAL Background%, Attr%)
DECLARE SUB DCal (Scrn%(), CalDate$)
DECLARE SUB DScrRest (BYVAL DSeg%, BYVAL DOfs%, BYVAL Page%, BYVAL Fast%)
DECLARE SUB DXQPrint (BYVAL DSeg%, BYVAL DOfs%, St$, BYVAL Row%, BYVAL Column%, BYVAL Attr%)
DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
DECLARE SUB GetKbd (Ins%, Caps%, Num%, ScrollLock%)
DECLARE SUB SetKbd (BYVAL Ins%, BYVAL Caps%, BYVAL Num%, BYVAL ScrollLock%)
DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)
SUB DCalendar (Scrn%(), CalDate$, Page%, Fast%)
L% = LBOUND(Scrn%)
CalcAttr 12, 0, InputStrAttr% ' input prompt
CalcAttr 14, 0, InputAttr% ' user input
CalcAttr 11, 1, StatusTextAttr% ' status line text
CalcAttr 0, 7, StatusKeyAttr% ' status line keys
St$ = CHR$(27)
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 2, StatusKeyAttr%
St$ = "Last Month"
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 4, StatusTextAttr%
St$ = CHR$(26)
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 15, StatusKeyAttr%
St$ = "Next Month"
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 17, StatusTextAttr%
St$ = CHR$(24)
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 28, StatusKeyAttr%
St$ = "Last Year"
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 30, StatusTextAttr%
St$ = CHR$(25)
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 40, StatusKeyAttr%
St$ = "Next Year"
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 42, StatusTextAttr%
St$ = "<Home>"
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 52, StatusKeyAttr%
St$ = "Enter Date"
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 59, StatusTextAttr%
St$ = "<ESC>"
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 70, StatusKeyAttr%
St$ = "Exit"
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 76, StatusTextAttr%
IF LEN(CalDate$) >= 8 THEN
MonthNr% = CINT(VAL(CalDate$))
YearNr% = CINT(VAL(MID$(CalDate$, 7)))
ELSE
St$ = DATE$
MonthNr% = CINT(VAL(St$))
YearNr% = CINT(VAL(MID$(St$, 7)))
END IF
IF YearNr% < 100 THEN YearNr% = YearNr% + 1900
DO
CDate$ = RIGHT$("0" + MID$(STR$(MonthNr%), 2), 2) + "-01-"
CDate$ = CDate$ + MID$(STR$(YearNr%), 2)
DCal Scrn%(), CDate$
DScrRest VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), Page%, Fast%
GetKey 0, ASCIICode%, ScanCode%, LeftB%, RightB%
SELECT CASE ScanCode%
CASE 75
IF MonthNr% = 1 THEN
IF YearNr% > 1900 THEN
MonthNr% = 12
YearNr% = YearNr% - 1
END IF
ELSE
MonthNr% = MonthNr% - 1
END IF
CASE 77
IF MonthNr% = 12 THEN
MonthNr% = 1
YearNr% = YearNr% + 1
ELSE
MonthNr% = MonthNr% + 1
END IF
CASE 72
IF YearNr% > 1900 THEN YearNr% = YearNr% - 1
CASE 80
IF YearNr% < 9999 THEN YearNr% = YearNr% + 1
CASE 71
GetKbd Ins%, Caps%, Num%, Scrl%
SetKbd Ins%, Caps%, -1, Scrl%
St$ = SPACE$(80)
MID$(St$, 1) = "Date to display (MM/YY):"
CDate$ = ""
DO
XQPrint St$, 25, 1, InputStrAttr%, Page%, Fast%
XQPrint CDate$, 25, 26, InputAttr%, Page%, Fast%
SetKbd Ins%, Caps%, -1, Scrl%
DO
ky$ = INKEY$
LOOP UNTIL LEN(ky$)
IF INSTR("0123456789/", ky$) > 0 AND LEN(CDate$) < 10 THEN
CDate$ = CDate$ + ky$
ELSEIF (ASC(ky$) = 8 OR ASC(ky$) = 127) AND LEN(CDate$) > 0 THEN
CDate$ = LEFT$(CDate$, LEN(CDate$) - 1)
END IF
LOOP UNTIL ASC(ky$) = 13
SetKbd Ins%, Caps%, Num%, Scrl%
tmp% = INSTR(CDate$, "/")
IF tmp% THEN
MonthNr% = CINT(VAL(CDate$))
YearNr% = CINT(VAL(MID$(CDate$, tmp + 1)))
IF MonthNr% < 1 THEN
MonthNr% = 1
ELSEIF MonthNr% > 12 THEN
MonthNr% = 12
END IF
IF YearNr% < 100 THEN YearNr% = YearNr% + 1900
IF YearNr% < 1900 THEN
YearNr% = 1900
ELSEIF YearNr% > 9999 THEN
YearNr% = 9999
END IF
END IF
CASE ELSE
END SELECT
LOOP UNTIL ASCIICode% = 27
END SUB